home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / dbase / lib19.zip / DATES.PRG < prev    next >
Text File  |  1992-06-25  |  36KB  |  924 lines
  1. *-------------------------------------------------------------------------------
  2. *-- Program...: DATES.PRG
  3. *-- Programmer: Ken Mayer (KENMAYER)
  4. *-- Date......: 06/25/1992
  5. *-- Notes.....: These are the date functions/procedures I felt were not as
  6. *--             commonly used as those left behind in PROC.PRG. See README.TXT
  7. *--             for details on the use of this library file.
  8. *-------------------------------------------------------------------------------
  9.  
  10. FUNCTION DateText3
  11. *-------------------------------------------------------------------------------
  12. *-- Programmer..: Miriam Liskin
  13. *-- Date........: 03/02/1992
  14. *-- Notes.......: Display date in format  Month, year
  15. *-- Written for.: dBASE IV, 1.1
  16. *-- Rev. History: 05/21/1991 - original function.
  17. *--               03/02/1992 - This one's Douglas P. Saine's (XRED) invention.
  18. *--               In his words: "I just removed the middle part looking for
  19. *--               the day. For the things I do, I only need the month and
  20. *--               year. (I work for a defense contracter, accuracy of dates
  21. *--               has never been of great concern. <G>)"
  22. *-- Calls.......: None
  23. *-- Called by...: Any
  24. *-- Usage.......: DateText3(<dDate>)
  25. *-- Example.....: ? DateText3(date())
  26. *-- Returns.....: July, 1991
  27. *-- Parameters..: dDate = date to be converted
  28. *-------------------------------------------------------------------------------
  29.  
  30.     parameters dDate
  31.     
  32. RETURN cmonth(dDate)+", "+str(year(dDate),4)
  33. *-- EoF: DateText3()
  34.  
  35. FUNCTION Age2
  36. *-------------------------------------------------------------------------------
  37. *-- Programmer..: Martin Leon (HMAN)
  38. *-- Date........: 04/22/1992
  39. *-- Notes.......: Returns number of full years between two dates, which is
  40. *--               age of a person born on the first date as of the second.
  41. *-- Written for.: dBASE IV, 1.1
  42. *-- Rev. History: 10/23/1991 - original function.
  43. *--               04/22/1992 -- Description modified, parameters changed by
  44. *--               Jay Parsons (JPARSONS).
  45. *-- Calls.......: None
  46. *-- Called by...: Any
  47. *-- Usage.......: Age2(<d1>,<d2>)
  48. *-- Example.....: ? "Joe was "+ltrim(str(age2(dBDay,{10/16/85})))+;
  49. *--                        " on the day of ..."
  50. *-- Returns.....: Numeric value in years
  51. *-- Parameters..: d1 = first date, such as date of birth
  52. *--               d2 = second date, when age is wanted
  53. *-------------------------------------------------------------------------------
  54.  
  55.     parameters d1, d2
  56.     private nYears
  57.     
  58.     nYears = year(d2) - year(d1)
  59.     do case
  60.         case month(d1) > month(d2)
  61.             nYears = nYears - 1
  62.         case month(d1) = month(d2)
  63.             if day(d1) > day(d2)
  64.                 nYears = nYears - 1
  65.             endif
  66.     endcase
  67.  
  68. RETURN nYears
  69. *-- EoF: Age2()
  70.  
  71. FUNCTION IsLeap
  72. *-------------------------------------------------------------------------------
  73. *-- Programmer..: Jay Parsons (JPARSONS)
  74. *-- Date........: 01/13/1992
  75. *-- Notes.......: Is the year given a Leap Year? Year given must be after 1500
  76. *-- Written for.: dBASE IV, 1.1
  77. *-- Rev. History: 11/08/1991 - original function.
  78. *--               01/13/1992 -- updated to handle two digit OR four digit year.
  79. *-- Calls.......: None
  80. *-- Called by...: Any
  81. *-- Usage.......: IsLeap(<nYear>)
  82. *-- Example.....: IsLeap(91)
  83. *-- Returns.....: Logical (.t./.f.) 
  84. *-- Parameters..: nYear  = Numeric form of year -- last two digits (i.e., 91),
  85. *--                        or all four digits (i.e., 1991)
  86. *-------------------------------------------------------------------------------
  87.     
  88.     parameter nYear
  89.     private lReturn
  90.     
  91.     *-- deal with two digit year ...
  92.     if nYear < 100
  93.         nYear = nYear + 100 * int(year(date())/100)
  94.     endif
  95.     
  96.     lReturn = mod(iif(mod(nYear,100)=0,nYear/100,nYear),4)=0
  97.     
  98. RETURN lReturn
  99. *-- EoF: IsLeap()
  100.  
  101. FUNCTION Annivrsry
  102. *-------------------------------------------------------------------------------
  103. *-- Programmer..: David Love (DAVIDLOVE) and Jay Parsons (JPARSONS)
  104. *-- Date........: 11/10/1991
  105. *-- Notes.......: Checks to see if an anniversary date falls within a range of
  106. *--               dates (handy for mailings for organizations, checking to see
  107. *--               if someone's birthday falls within certain dates, etc.
  108. *-- Written for.: dBASE IV, 1.1
  109. *-- Rev. History: None
  110. *-- Calls.......: AGE2()               Function in DATES.PRG
  111. *-- Called by...: Any
  112. *-- Usage.......: Annivrsry(<dTest>,<dBegin>,<dEnd>)
  113. *-- Example.....: if Annivrsry(dBDay,{03/01/91},{03/31/91})
  114. *--                  *-- do something
  115. *--               endif
  116. *-- Returns.....: .t. if a date (dTest) falls within the period beginning at
  117. *--               dBegin or ending at dEnd, inclusive. .F. for any other
  118. *--               occurance, including invalid ranges or blank dates.
  119. *-- Parameters..: dTest  = Date being tested for ...
  120. *--               dBegin = Beginning of range
  121. *--               dEnd   = End of range
  122. *-------------------------------------------------------------------------------
  123.  
  124.     parameters dTest, dBegin, dEnd
  125.     private nYears
  126.     
  127.     nYears = 0
  128.     if dBegin <= dEnd .AND. dTest <= dEnd        && will be false if blank
  129.       nYears = age2(dTest,dEnd) - iif(dTest < dBegin,age2(dTest,dBegin-1),0)
  130.     endif
  131.  
  132. RETURN nYears > 0
  133. *-- EoF: Annivrsry()
  134.  
  135. FUNCTION AddMonths
  136. *-------------------------------------------------------------------------------
  137. *-- Programmer..: Jay Parsons (JPARSONS)
  138. *-- Date........: 11/10/1991
  139. *-- Notes.......: Finds same day as given date N months ahead. 
  140. *--               This function will return the first day of the following
  141. *--               month if there is no date in the month otherwise returned 
  142. *--               and nMonths is positive, or the last day of the month if 
  143. *--               nMonths is negative.  That is, a call with {01/31/91} 
  144. *--               (January 31, 1991) and 1 would yield March 1, there being 
  145. *--               no February 31.
  146. *--                 Do not use this function successively to find first the
  147. *--               date one month ahead, then the date one month beyond that.  
  148. *--               Instead, to find the date two months ahead from the original 
  149. *--               date, call this function with the original date and 
  150. *--               nMonths = 2.  Otherwise, in the example, you'll get April 1 
  151. *--               the second time rather than the correct March 31.
  152. *-- Written for.: dBASE IV, 1.1
  153. *-- Rev. History: None
  154. *-- Calls.......: None
  155. *-- Called by...: Any
  156. *-- Usage.......: AddMonths(<dDate>,<nMonths>)
  157. *-- Example.....: ?AddMonths({01/01/91},1)
  158. *-- Returns.....: Date
  159. *-- Parameters..: dDate   = Date being tested for ...
  160. *--               dMonths = Number of months "ahead"
  161. *-------------------------------------------------------------------------------
  162.     
  163.     parameters dDate, nMonths
  164.     private dNew, dTest,dReturn
  165.     
  166.     dNew = dDate - day(dDate)+ 15 + 30.436875 * nMonths  && middle of month
  167.     dTest = dNew - day(dNew) + day(dDate)
  168.     dReturn = iif(month(dTest) = month(dNew),dTest, ;
  169.            dTest - day(dTest) + iif(nMonths > 0, 1, 0))
  170.  
  171. RETURN dReturn
  172. *-- EoF: AddMonths()
  173.  
  174. FUNCTION AddYears
  175. *-------------------------------------------------------------------------------
  176. *-- Programmer..: Jay Parsons (JPARSONS)
  177. *-- Date........: 11/14/1991
  178. *-- Notes.......: Finds same day as given date N years ahead. 
  179. *--               Using this function dBASE IV will take care of converting 
  180. *--               February 29 to March 1 if moving from a leap to a non-leap
  181. *--               year.  However, neither may be used backwards (negative 
  182. *--               value of nYears) since the date a year before February 29,
  183. *--               1992 will be returned as March 1, 1991, not February 28, 1991.
  184. *--               If you must move back, either check explicitly for February 29
  185. *--               as the original date or add code as in the addmonths()
  186. *--               function to test for the date returned being of a different
  187. *--               month than the original and, if it is, to subtract its day().
  188. *-- Written for.: dBASE IV, 1.1
  189. *-- Rev. History: 11/10/1991 - original function.
  190. *--               11/14/1991 - Ken Mayer - expanded out